Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/cat/groupcom.i

Text File | 1997-10-26 | 6KB | 174 lines

IMPLEMENTATION MODULE GroupComment;

(*==============================================================*
 * Modul:               gruppenbergreifende Kommentare         *
 * Autor:               Johannes G”ttker-Schnetmann             *
 * erstellt am:         28.12.1991                              *
 * letzte Žnderung am:  30.01.1993                              *
 * Version:             0.1                                     *
 * Interne Version:     V#0002                                  *
 *==============================================================*

  Das Problem, aus einem String eine ID und eine Gruppe herauszuholen besteht sowohl
  in data.i als auch in grin.i. In ersterem Modul schon w„hrend des Einfgens,
  dann wird versucht anhand einer solchen Zeile eine Kommentarverkettung herzustellen
  und in grin beim Sprung ber eine gruppenbergreifende Kommentarverkettung.

 *----------------------------------------------------------------------------
 * Datum    Vers. Autor  Žnderung (Arbeitsbericht)
 *----------------------------------------------------------------------------
 * 28.12.91 0001  JGS    Erste Version
 * 30.01.93 0002  JGS    Gruppennamen werden "geupcased"
 *----------------------------------------------------------------------------
 *)

FROM SYSTEM     IMPORT ADDRESS, ADR;
FROM CatTypes   IMPORT Str1023Ptr;
FROM Void       IMPORT v;
IMPORT MagicStrings;

  PROCEDURE IDPos(REF str : ARRAY OF CHAR; VAR begin : CARDINAL):BOOLEAN;
  (* Sieht nach, ob mit dem bergebenen String eine Kommentarverkettung hergestellt *)
  (* werden kann. Falls ja, steht der Beginn der ID in <begin>                      *)
  CONST com = 'KOMMENTAR ZU ';
        dem = 'DEMENTI ZU ';
  VAR pos : CARDINAL; vgl : ARRAY[0..14] OF CHAR;
      l   : CARDINAL;
      ok  : BOOLEAN;
  BEGIN
    vgl := com; (* Leider geht com[n] nicht.. :-( *)
    pos := 0;
    l := LENGTH (vgl);
    ok := TRUE;
    WHILE (pos < l) & ok DO
      IF MagicStrings.Cap(str[pos]) # vgl[pos] THEN ok := FALSE END;
      INC (pos);
    END;
    IF ~ok
    THEN
      vgl := dem; (* Leider geht com[n] nicht.. :-( *)
      pos := 0;
      l := LENGTH (vgl);
      ok := TRUE;
      WHILE (pos < l) & ok DO
        IF MagicStrings.Cap(str[pos]) # vgl[pos] THEN ok := FALSE END;
        INC (pos);
      END;
    END;
    IF ~ok THEN RETURN FALSE END;
    (*
    FOR pos := 0 TO LENGTH(vgl)-1 DO
      IF MagicStrings.Cap(str[pos]) # vgl[pos] THEN RETURN FALSE END;
    END;
    *)
    begin := LENGTH(vgl);
    RETURN TRUE;
  END IDPos;

  PROCEDURE stampEnd(VAR str      : Str1023Ptr;
                     VAR saveChar : CHAR;
                     VAR savePos  : CARDINAL;
                     VAR atSign   : BOOLEAN; (* Kam ein '@' vor? *)
                         termChar : CHAR);
  VAR lauf : CARDINAL;
  BEGIN
    (* Hier jetzt noch das Ende suchen.. (Buchstabe ab/unter ' ' = 32C) *)
    lauf := 0;
    atSign := FALSE;
    WHILE (lauf < 1023) & (str^[lauf] > termChar) DO
      IF str^[lauf] = '@' THEN atSign := TRUE END;
      INC(lauf);
    END;
    saveChar   := str^[lauf];
    savePos    := lauf;
    str^[lauf] := 0C;
  END stampEnd;

  PROCEDURE PrepareID(REF pText    : Str1023Ptr;
                      VAR str      : Str1023Ptr;
                      VAR saveChar : CHAR;
                      VAR savePos  : CARDINAL):BOOLEAN;
  (* Aus dem in <str> stehenden String eine ID herausholen oder auch nicht.. :-) *)
  (* In <saveChar> steht anschliežend ein Buchstabe, der bei <savePos> im        *)
  (* entnommen im erfolgreichen Fall wurde *)
  VAR bgn, lauf : CARDINAL; atSign : BOOLEAN;
  BEGIN
    IF (pText^[0] = '-') OR (pText^[0] = 'K') OR (pText^[0] = 'D') THEN
      bgn := 0;
      IF pText^[0] = '-' THEN
        str := pText+ADDRESS(1);
      ELSE
        str := pText;
        IF IDPos(str^, bgn) THEN
          str := ADDRESS(str) + ADDRESS(LONG(bgn));
        ELSE
          RETURN FALSE
        END;
      END;
      stampEnd(str, saveChar, savePos, atSign, ' ');      (* Ende markieren *)
      IF atSign THEN
        RETURN TRUE
      ELSE
        str^[savePos] := saveChar; (* zurcksetzen *)
        RETURN FALSE
      END;
    ELSE
      RETURN FALSE
    END;
  END PrepareID;

  PROCEDURE iGroupPos(REF str   : ARRAY OF CHAR;
                     VAR begin : CARDINAL;
                     REF vgl : ARRAY OF CHAR):BOOLEAN;
  VAR pos : CARDINAL;
  BEGIN
    FOR pos := 0 TO LENGTH(vgl)-1 DO
      IF MagicStrings.Cap(str[pos]) # vgl[pos] THEN RETURN FALSE END;
    END;
    begin := LENGTH(vgl);
    RETURN TRUE;
  END iGroupPos;

  PROCEDURE GroupPos(REF str   : ARRAY OF CHAR;
                     VAR begin : CARDINAL):BOOLEAN;
  CONST gruppe1 = 'IN DER GRUPPE ';
        gruppe2 = 'IN GRUPPE ';
        gruppe3 = 'IN ';
  BEGIN
    RETURN iGroupPos(str, begin, gruppe1) OR
           iGroupPos(str, begin, gruppe2) OR
           iGroupPos(str, begin, gruppe3);
  END GroupPos;


  PROCEDURE PrepareGroup(REF pStr : Str1023Ptr;
                         VAR str  : Str1023Ptr):BOOLEAN;
  VAR bgn : CARDINAL; old : CHAR; pos : CARDINAL;
  BEGIN
    IF GroupPos(pStr^, bgn) THEN
      str := pStr + ADDRESS(LONG(bgn));
      stampEnd(str, old, pos, v.bool, 37C);
      IF (pos > 0) & (str^[pos-1] = ':') THEN
        str^[pos] := old;
        str^[pos-1] := 0C;
      END;
      MagicStrings.CAPS(str^);
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END;
  END PrepareGroup;

  PROCEDURE PrepareIDnGroup(VAR str      : ARRAY OF CHAR;
                            VAR id       : Str1023Ptr;
                            VAR gr       : Str1023Ptr):BOOLEAN;
  (* Aus dem in <str> stehenden String die ID und Gruppe herausholen oder nicht.    *)
  (* <id> zeigt anschliežend auf die nullterminierte ID                             *)
  (* und <gr> auf die nullterminiert Gruppe innerhalb von <str>                     *)
  BEGIN
    RETURN PrepareID(ADR(str), id, v.char, v.card) &
           PrepareGroup(ADDRESS(id)+ADDRESS(LONG(LENGTH(id^))+1), gr);
  END PrepareIDnGroup;

END GroupComment.